Introdução

Com esta anĂĄlise temos como objetivo responder Ă  questĂŁo De que forma a mobilidade estĂĄ associada Ă  ocorrĂȘncia de novos casos?

Deste modo, queremos perceber se o movimento de pessoas estĂĄ associado a um aumento do nĂșmero de casos de COVID19 quer a nĂ­vel nacional, quer a nĂ­vel distrital.

Para esta anĂĄlise baseĂĄmo-nos na metodologia usada pelo artigo do The Lancet.

Para obtermos os dados da movimentação da população por distrito em Portugal, recorremos à base de dados disponível em The Humanitarian Data Exchange cuja explicação das fórmulas utilizadas se encontra em Facebook Research. Relativamente aos dados da taxa de crescimento de novos casos utilizåmos a base de dados disponível no github da Data Science for Social Good Portugal.

# IMPORTAR LIBRARIES
library(data.table)
library(dplyr)
library(zoo)
library(geojsonio)
library(leaflet)
library(htmlwidgets)
library(htmltools)
library(ggplot2)
library(plotly)
library(stringdist)
library(Ecfun)
library(tibble)
library(ggpmisc)
library(corrr)


# IMPORTAR BASE DE DADOS SOBRE MOBILIDADE DIÁRIA POR DISTRITOS NO MUNDO DISPONIVEIS  EM: <https://data.humdata.org/dataset/movement-range-maps>

mobilidade_r <- fread("C:/Users/rakac/OneDrive - Universidade de Lisboa/R/Faculdade/2.COVID19 Portugal/Partilhado/Mobilidade_COVID19/dados_mobilidade/movement-range-2020-10-10.txt")

#mobilidade_c <- fread("C:/Users/karol/Documents/R/Covid-19_estagio/Epivet2020/movement-range-2020-10-10.txt")


# IMPORTAR BASE DE DADOS DO COVID19 EM PORTUGAL DISPONIVEL EM: <https://github.com/dssg-pt/covid19pt-data>
covid19pt <- fread("https://raw.githubusercontent.com/dssg-pt/covid19pt-data/master/data.csv")

## por as datas em formato data
covid19pt$data <- as.Date(as.character(covid19pt$data),format = "%d-%m-%Y")


# IMPORTAR BASE DE DADOS DOS CASOS POR CONCELHO DISPONIVEL EM: <https://github.com/dssg-pt/covid19pt-data>
covid_concelhos <- fread("https://raw.githubusercontent.com/dssg-pt/covid19pt-data/master/data_concelhos.csv")


# IMPORTAR BASE DE DADOS QUE CORRELACIONA CONCELHOS COM DSTRITOS DISPONIVEL EM: <https://www.factorvirtual.com/blog/distritos-concelhos-e-freguesias-de-portugal>
concelho_distrito <- fread("https://raw.githubusercontent.com/EpiVet2020/Mobilidade_COVID19/main/concelho_distrito.csv?token=AO4UTAQEC3FVBS56S6XDNYC7R3ZL2") %>% 
  select("Designação DT", "Designação CC")


# IMPORTAR MAPA DOS DISTRITOS DE PORTUGAL DISPONIVEIS  EM: <https://github.com/ufoe/d3js-geojson/blob/master/Portugal.json>
mapa_distritos <- geojson_read("https://raw.githubusercontent.com/ufoe/d3js-geojson/master/Portugal.json", what = "sp")

Taxa de Mobilidade (MR)

A base de dados da mobilidade apresenta valores entre -1 e 1. Os valores negativos indicam uma diminuição da movimentação de pessoas em Portugal quando comparado com um dia padrão antes do início da pandemia (fevereiro) e os valores positivos indicam um aumento dessa movimentação.

No artigo The Lancet os valores da mobilidade variam entre 0 e >1. O valor 0 indica que nĂŁo houve movimentaçÔes, 0.5 significa que foram feitas metade das movimentaçÔes em relação ao padrĂŁo, 1 indica que nĂŁo houve alteração no nĂșmero de movimentaçÔes em relação ao padrĂŁo e >1 significa que o nĂșmero de movimentaçÔes aumentou.

Para os nossos dados terem o mesmo intervalo do que o do artigo, decidimos normalizar os nossos dados somando 1.

# TRATAR BASE DE DADOS DA MOBILIDADE

## Selecionar Portugal na base de dados
mobilidade_pt <- mobilidade_r %>% 
  filter(country=="PRT")

## Corrigir os nomes dos distritos
mobilidade_pt$polygon_name[mobilidade_pt$polygon_name == "Santar-m" | mobilidade_pt$polygon_name == "Santarém"] <- "Santarem"

mobilidade_pt$polygon_name[mobilidade_pt$polygon_name == "Set-bal" | mobilidade_pt$polygon_name == "SetÃÂșbal"] <- "Setubal"

mobilidade_pt$polygon_name[mobilidade_pt$polygon_name == "Bragan-a" | mobilidade_pt$polygon_name == "Bragança"] <- "Braganca"

mobilidade_pt$polygon_name[mobilidade_pt$polygon_name == "-vora" | mobilidade_pt$polygon_name == "Évora"] <- "Evora"

## Normalizar mobility rate para que o 0 passe a representar a ausĂȘncia de mobilidade
mobilidade_pt$all_day_bing_tiles_visited_relative_change = mobilidade_pt$all_day_bing_tiles_visited_relative_change + 1

Evolução Nacional


Uma vez que apenas temos a taxa de mobilidade por distrito, recorremos à média ponderada para obter a taxa de mobilidade diåria nacional.

Neste grĂĄfico podemos ver que desde o inĂ­cio da pandemia atĂ© Ă  atualidade, a curva da tendĂȘncia da taxa de mobilidade tem sido sempre inferior Ă  mobilidade utilizada como padrĂŁo (fevereiro), uma vez que a taxa de mobilidade Ă© sempre inferior a 1. É possĂ­vel verificar que nos meses da quarentena (abril e maio) a curva da tendĂȘncia da taxa de mobilidade atingiu o seu valor mĂ­nimo, cerca de 60%, o que significa que foram feitos 60% dos movimentos realizados em fevereiro, ou seja, uma redução de 40% das deslocaçÔes. A partir de maio, com o fim do isolamento obrigatĂłrio, a taxa de mobilidade subiu atingindo o seu valor mĂĄximo em meados de agosto, provavelmente devido a um maior nĂșmero de movimentaçÔes, intrĂ­nseco ao perĂ­odo de fĂ©rias. A partir de setembro, com o fim do perĂ­odo de fĂ©rias, a taxa de mobilidade tem vindo a diminuir.

# Dados do numero de pessoas por distrito disponiveis em <https://pt.db-city.com/Portugal>

pop_guarda = 176086
pop_leiria = 472895
pop_lisboa = 2203503
pop_madeira = 244286
pop_portalegre = 121653
pop_porto = 1805015
pop_santarem = 463676
pop_setubal = 829007
pop_vianadocastelo = 251937
pop_vilareal = 221218
pop_aveiro = 727041
pop_viseu = 395202
pop_acores = 241206
pop_beja = 156259
pop_braga = 851337
pop_braganca = 280180
pop_castelobranco = 203769
pop_coimbra = 437642
pop_evora = 171130
pop_faro = 411468

# Selecionar na tabela da mobilidade as colunas da data, distrito e mobilidade

mobilidade_distritos <- mobilidade_pt %>% 
  select(ds, polygon_name, all_day_bing_tiles_visited_relative_change)
names(mobilidade_distritos) = c("data", "distrito", "mobilidade")


# Tabela com a populacao por distrito

pop_distritos <- data.frame(distrito = c("Guarda", "Leiria", "Lisboa", "Madeira", "Portalegre", "Porto", "Santarem", "Setubal", 
                                         "Viana do Castelo","Vila Real", "Aveiro", "Viseu", "Azores", "Beja", "Braga", "Braganca", 
                                         "Castelo Branco", "Coimbra", "Evora", "Faro"), 
                            populacao = c(pop_guarda, pop_leiria , pop_lisboa, pop_madeira, pop_portalegre, pop_porto, pop_santarem, 
                                          pop_setubal, pop_vianadocastelo,pop_vilareal, pop_aveiro, pop_viseu, pop_acores, pop_beja, 
                                          pop_braga, pop_braganca, pop_castelobranco, pop_coimbra, pop_evora,pop_faro))


#Juntar as duas tabelas anteriores pelo distrito

mobilidade_distritos <- left_join(mobilidade_distritos, pop_distritos, by = "distrito")


# Nova coluna com a multiplicacao da mobilidade pela populacao de cada distrito (para a media ponderada)

mobilidade_distritos <- mobilidade_distritos %>% 
  mutate(mobilidadexpopulacao = mobilidade * populacao)


# Tabela com a media ponderada do mobility rate nacional por dia (soma das multiplicacoes anteriores a dividir pela populacao de Portugal)

mobilidade_nacional <- mobilidade_distritos %>% 
  group_by(data) %>% 
  summarise(mobilidade_ponderada = sum(mobilidadexpopulacao) / sum(pop_distritos$populacao))


mobilidade_nacional$data <- as.Date(mobilidade_nacional$data,format = "%d-%m-%Y")

# Grafico da evolucao da taxa de mobilidade nacional

mobilidade_nacional_grafico <- ggplot(mobilidade_nacional, aes(x = data, y = mobilidade_ponderada)) +
  geom_point(size = 0.7, aes(text = paste('Data: ', data,
                                           '<br>Taxa de Mobilidade:', mobilidade_ponderada))) +
  geom_smooth(se = FALSE, size = 0.7, color = "#64CEAA") +
  labs(title = "Evolução da Taxa de Mobilidade (MR) Nacional",
       x = "MĂȘs",
       y = "MR") +
  theme_classic() +
  theme(legend.title = element_blank()) +
  scale_x_date(breaks = "months", date_labels = "%b") +
  geom_line(aes(y = 1, text = ""), size = 0.5, color = "black", linetype = "dotted") +
  scale_y_continuous(breaks = seq(0, 1.1, 0.2))

ggplotly(mobilidade_nacional_grafico, tooltip = "text")

Evolução Distrital

De modo a percebermos a evolução da taxa de mobilidade em Portugal, decidimos fazer trĂȘs mapas em trĂȘs situaçÔes epidemiolĂłgicas distintas.


Dia 01-03-2020


Começåmos por fazer um mapa da mobilidade antes do início da pandemia em Portugal, tendo para isso escolhido o dia 01-03-2020 por ser a primeira data que temos na nossa base de dados.

# MAPA DA MOBILIDADE POR DISTRITOS

## Mapa do dia 2020-03-01 (antes da pandemia)

### Selecionar todas as linhas do dia 2020-03-01
mobilidade_pre_covid <- as.data.frame(with(mobilidade_pt, mobilidade_pt[(ds=="2020-03-01")]))

### Ordenar os distritos pela mesma ordem do que as do mapa
ordem <- c("Setubal", "Azores", "Madeira", "Aveiro", "Leiria", "Viana do Castelo", "Beja", "Evora", "Faro", "Lisboa", "Portalegre", "Santarem", "Braga", "Braganca", "Castelo Branco", "Coimbra", "Guarda", "Porto", "Viseu", "Vila Real")

mobilidade_pre_covid_ordem <- mobilidade_pre_covid %>% 
  slice(match(ordem,polygon_name))

### Fazer uma palete de cores com 100 tonalidades e aplica-las ao intervalo entre 0.3 e 1.21 que sao o mĂ­nimo e o maximo do mobility rate
palete <- colorRampPalette(colors = c("white", "yellow", "pink", "red"), space = "Lab")(100)

pal_mobilidade_covid <-  colorNumeric(palete, domain = c(0.3, 1.21))

### Criar legenda para quando se passa o rato por cima
labels_mobilidade_pre_covid <- paste( 
  "<strong>", mobilidade_pre_covid_ordem[,5],"</strong><br/>", 
  mobilidade_pre_covid_ordem[,6], " <br/>", 
  sep="") %>%
  lapply(htmltools::HTML)

### Criar o mapa com os valores por distrito
leaflet(mapa_distritos) %>%
  addPolygons(stroke = TRUE, smoothFactor = 0.3, fillOpacity = 1, color = "black", weight = 1,
              fillColor = ~pal_mobilidade_covid(mobilidade_pre_covid_ordem$all_day_bing_tiles_visited_relative_change),
              label = labels_mobilidade_pre_covid, 
              labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "13px", direction = "auto")) %>% 
  addTiles(group = "Normal") %>% 
  addProviderTiles(providers$CartoDB.Positron, group = "Claro") %>% 
  addProviderTiles(providers$CartoDB.DarkMatterNoLabels, group = "Escuro") %>% 
  addLayersControl(
    baseGroups = c("Normal", "Claro", "Escuro"),
    options = layersControlOptions(collapsed = TRUE)
  ) %>%
  addLegend("bottomleft", pal = pal_mobilidade_covid, values = mobilidade_pre_covid_ordem$all_day_bing_tiles_visited_relative_change, 
            opacity = 0.5, title = "Taxa de Mobilidade por distrito dia 01-03-2020")

Dia 10-04-2020


De seguida fizémos um mapa da taxa de mobilidade para um dia do período de quarentena em Portugal.

Com a anålise deste mapa é possível verificar que a taxa de mobilidade diminuiu consideravelmente, apresentando valores entre os 30 e os 42%, o que significa que se mantiveram apenas 30 a 42% dos movimentos realizados em fevereiro (padrão). A maior diminuição é verificada no distrito de Lisboa, com uma redução de cerca de 70% das suas deslocaçÔes.

## Mapa do dia 2020-04-10 (em quarentena)

### Selecionar todas as linhas do dia 2020-04-10
mobilidade_covid_quarentena <- as.data.frame(with(mobilidade_pt, mobilidade_pt[(ds=="2020-04-10")]))

### Ordenar os distritos pela mesma ordem do que as do mapa
mobilidade_covid_quarentena_ordem <- mobilidade_covid_quarentena %>% 
  slice(match(ordem,polygon_name))

### Criar legenda para quando se passa o rato por cima
labels_mobilidade_covid_quarentena <- paste( 
  "<strong>", mobilidade_covid_quarentena_ordem[,5],"</strong><br/>", 
  mobilidade_covid_quarentena_ordem[,6], " <br/>", 
  sep="") %>%
  lapply(htmltools::HTML)

### Criar o mapa com os valores por distrito
leaflet(mapa_distritos) %>%
  addPolygons(stroke = TRUE, smoothFactor = 0.3, fillOpacity = 1, color = "black", weight = 1,
              fillColor = ~pal_mobilidade_covid(mobilidade_covid_quarentena_ordem$all_day_bing_tiles_visited_relative_change),
              label = labels_mobilidade_covid_quarentena, 
              labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "13px", direction = "auto")) %>% 
  addTiles(group = "Normal") %>% 
  addProviderTiles(providers$CartoDB.Positron, group = "Claro") %>% 
  addProviderTiles(providers$CartoDB.DarkMatterNoLabels, group = "Escuro") %>% 
  addLayersControl(
    baseGroups = c("Normal", "Claro", "Escuro"),
    options = layersControlOptions(collapsed = TRUE)
  ) %>%
  addLegend("bottomleft", pal = pal_mobilidade_covid, values = mobilidade_covid_quarentena_ordem$all_day_bing_tiles_visited_relative_change, 
            opacity = 0.5, title = "Taxa de Mobilidade por distrito dia 10-04-2020")

Dia 14-09-2020


Por fim realizĂĄmos um mapa da taxa de mobilidade no primeiro dia de aulas em Portugal.

É possĂ­vel verificar que a taxa de mobilidade sofreu um aumento em relação ao dia 01-03-2020, data na qual ainda nĂŁo havia casos em Portugal. Isto pode dever-se ao facto do mĂȘs de setembro ter normalmente mais movimentaçÔes do que o mĂȘs de março, independentemente da pandemia. Assim, idealmente dever-se-ia usar como padrĂŁo o mesmo mĂȘs do ano anterior para se perceber se efetivamente a taxa de mobilidade em setembro aumentou.

## Mapa do dia 2020-09-14 (regresso Ă s aulas)

### Selecionar todas as linhas do dia 2020-09-14
mobilidade_covid_aulas <- as.data.frame(with(mobilidade_pt, mobilidade_pt[(ds=="2020-09-14")]))

### Ordenar os distritos pela mesma ordem do que as do mapa
mobilidade_covid_aulas_ordem <- mobilidade_covid_aulas %>% 
  slice(match(ordem,polygon_name))

### Criar legenda para quando se passa o rato por cima
labels_mobilidade_covid_aulas <- paste( 
  "<strong>", mobilidade_covid_aulas_ordem[,5],"</strong><br/>", 
  mobilidade_covid_aulas_ordem[,6], " <br/>", 
  sep="") %>%
  lapply(htmltools::HTML)

### Criar o mapa com os valores por distrito
leaflet(mapa_distritos) %>%
  addPolygons(stroke = TRUE, smoothFactor = 0.3, fillOpacity = 1, color = "black", weight = 1,
              fillColor = ~pal_mobilidade_covid(mobilidade_covid_aulas_ordem$all_day_bing_tiles_visited_relative_change),
              label = labels_mobilidade_covid_aulas, 
              labelOptions = labelOptions(style = list("font-weight" = "normal", padding = "3px 8px"), textsize = "13px", direction = "auto")) %>% 
  addTiles(group = "Normal") %>% 
  addProviderTiles(providers$CartoDB.Positron, group = "Claro") %>% 
  addProviderTiles(providers$CartoDB.DarkMatterNoLabels, group = "Escuro") %>% 
  addLayersControl(
    baseGroups = c("Normal", "Claro", "Escuro"),
    options = layersControlOptions(collapsed = TRUE)
  ) %>%
  addLegend("bottomleft", pal = pal_mobilidade_covid, values = mobilidade_covid_aulas_ordem$all_day_bing_tiles_visited_relative_change, 
            opacity = 0.5, title = "Taxa de Mobilidade por distrito dia 14-09-2020")

Mapa da Evolução


Gråfico da Evolução


Com a anĂĄlise deste grĂĄfico vemos que Lisboa Ă© o distrito que, ao longo de todos os meses, tem tido a maior redução da taxa de mobilidade. Durante o perĂ­odo de quarentena, Beja foi o distrito com menor redução da taxa de mobilidade, mantendo cerca de 70% das suas deslocaçÔes. A partir de maio as movimentaçÔes começaram a subir em todos os distritos, sendo que os que foram consideravelmente superiores ao padrĂŁo foram Vila Real, Viana do Castelo, Faro e Açores. O distrito de Évora apresenta um comportamento diferente de todos os outros distritos uma vez que o valor mĂĄximo da taxa de mobilidade nĂŁo ocorreu durante as fĂ©rias de verĂŁo, estando ainda com uma tendĂȘncia crescente.

### Grafico com data no eixo do x, mobility rate no eixo do y e distrito nas cores das linhas

mobilidade_grafico <- ggplot(mobilidade_pt, aes(x = ds, y = all_day_bing_tiles_visited_relative_change, color = polygon_name)) +
  geom_point(size = 0.7,  aes(text = paste('Distrito:', polygon_name,
                                           '<br>Data: ', ds,
                                           '<br>Taxa de Mobilidade:', all_day_bing_tiles_visited_relative_change))) +
  geom_smooth(se = FALSE, size = 0.7) +
  labs(title = "Evolução da Taxa de Mobilidade (MR) por Distrito",
       x = "MĂȘs",
       y = "MR") +
  theme_classic() +
  theme(legend.title = element_blank()) +
  scale_x_date(breaks = "months", date_labels = "%b") +
  geom_line(aes(y = 1, text = ""), size = 0.5, color = "black", linetype = "dotted")

ggplotly(mobilidade_grafico, tooltip = "text")



Taxa de Crescimento de Novos Casos (GR)

Para perceber se a mobilidade afeta o nĂșmero de novos casos, tivemos de calcular a taxa de crescimento de novos casos. Segundo o The Lancet, a taxa de crescimento de novos casos calcula-se dividindo o logaritmo da mĂ©dia de novos casos dos Ășltimos 3 dias pelo logaritmo da mĂ©dia de novos casos dos Ășltimos 7 dias.


Nacional

Para alĂ©m de analisarmos a mĂ©dia de novos casos dos Ășltimos 3 dias e a taxa de crescimento de novos casos durante todo o perĂ­odo da pandemia, iremos apresentar tambĂ©m, separadamente, a anĂĄlise referente a 2 perĂ­odos distintos. O primeiro Ă© de março a maio, perĂ­odo no qual ainda nĂŁo eram aplicadas algumas importantes medidas de mitigação, nomeadamente a obrigatoriedade do uso de mĂĄscaras em locais fechados. O segundo perĂ­odo Ă© de maio Ă  atualidade, no qual as medidas de mitigação jĂĄ eram aplicadas mantendo-se semelhantes ao longo de todos os meses.


Março - Hoje


Com a anĂĄlise do primeiro grĂĄfico observamos que a curva da tendĂȘncia da mĂ©dia dos novos casos dos Ășltimos 3 dias aumentou atĂ© ao mĂȘs de maio, tendo diminuĂ­do atĂ© meados de agosto. A partir de setembro a mĂ©dia de novos casos começou novamente a subir tendo ultrapassado os valores do inĂ­cio da pandemia. Esta curva continua com tendĂȘncia crescente apresentando um declive bastante acentuado.

No segundo grĂĄfico Ă© possĂ­vel verificar que a taxa de crescimento de novos casos teve o seu valor mĂĄximo no inĂ­cio da pandemia, diminuindo de seguida atĂ© meados de maio. A partir de setembro a taxa de crescimento de novos casos tem sido superior a 1 o que significa que a taxa de crescimento dos Ășltimos 3 dias foi superior Ă  dos Ășltimos 7 dias.

# Para isso, fizemos uma tabela com uma coluna para a data e outra coluna para a divisao. Para a data, começa na linha 7 porque e o primeiro dia em que temos registos dos 7 dias anteriores. Para o numerador tem de se comecar na linha 5 pois o primeiro valor que queremos e para a linha 7 e ele precisa das duas linhas anteriores para fazer a rollmean dos ultimos 3 dias. Para o demoninador nao precisamos de especificar onde queremos que comece porque ele so comeca quando tem 7 registos disponiveis

gr <- as.data.frame(cbind(covid19pt[7:nrow(covid19pt),1], as.data.frame(log(rollmean(covid19pt[5:nrow(covid19pt),12], k=3))
                                                                        /log(rollmean(covid19pt[,12], k = 7)))))
names(gr) <- c("data", "Growth_Rate")

# Grafico da evolucao da taxa de crescimento de novos casos a nivel nacional
gr_evolucao_grafico <- ggplot(gr, aes(x = data, y = Growth_Rate)) +
  geom_point(size = 0.7, aes(text = paste('Data: ', data,
                              '<br>Taxa de Crescimento de Novos Casos:', Growth_Rate))) +
  geom_smooth(color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  ylim(0.7, 1.5) + # ver se isto pode ser mesmo aplicado
  labs(title = "Evolução da Taxa de Crescimento de Novos Casos (GR)",
       x = "MĂȘs",
       y = "GR") +
  theme(plot.title = element_text(size=9),
        axis.title.x = element_text(size=9),
        axis.title.y = element_text(size=9)) +
  scale_x_date(breaks = "months", date_labels = "%b")
  

gr_evolucao_grafico_interativo <- ggplotly(gr_evolucao_grafico, tooltip = "text")


# Grafico da evolucao da media de casos dos ultimos 3 dias

rollmean_3_nacional <- as.data.frame(cbind(covid19pt[3:nrow(covid19pt),1], as.data.frame(rollmean(covid19pt[,12], k=3))))

rollmean_3_nacional_grafico <- ggplot(rollmean_3_nacional, aes(x = data, y = confirmados_novos)) + 
  geom_point(size = 0.7, aes(text = paste('Data: ', data,
                                          '<br>Novos casos (MĂ©dia):', confirmados_novos))) +
  geom_smooth(color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  labs(title = "Evolução dos Novos Casos (MĂ©dia dos Últimos 3 dias)",
       x = "MĂȘs",
       y = "Novos Casos (MĂ©dia dos Últimos 3 dias)") +
  theme(plot.title = element_text(size=9),
        axis.title.x = element_text(size=9),
        axis.title.y = element_text(size=9)) +
  scale_x_date(breaks = "months", date_labels = "%b")

rollmean_3_nacional_grafico_interativo <- ggplotly(rollmean_3_nacional_grafico, tooltip = "text")


browsable(
  tagList(list(
    tags$div(
      style = 'width:50%;display:block;float:left;',
      rollmean_3_nacional_grafico_interativo
    ),
    tags$div(
      style = 'width:50%;display:block;float:left;',
      gr_evolucao_grafico_interativo
    )
  ))
)

Março - Maio


Como expectĂĄvel, no inĂ­cio da pandemia a taxa de crescimento de novos casos era elevada e foi diminuindo sucessivamente atĂ© valores inferiores a 1, o que significa que a taxa de crescimento de novos casos nos Ășltimos 3 dias foi inferior Ă  da Ășltima semana. Esta diminuição pode dever-se ao perĂ­odo de quarentena.

#### Grafico da evolucao da taxa de crescimento de novos casos a nivel nacional

gr_marco_maio <- gr %>% 
  filter(data >= "2020-03-03" & data <= "2020-05-11")

gr_marco_maio_evolucao_grafico <- ggplot(gr_marco_maio, aes(x = data, y = Growth_Rate)) +
  geom_point(size = 0.7, aes(text = paste('Data: ', data,
                                          '<br>Taxa de Crescimento de Novos Casos:', Growth_Rate))) +
  geom_smooth(color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  ylim(0.7, 1.5) +
  labs(title = "Evolução da Taxa de Crescimento de Novos Casos (GR)",
       x = "MĂȘs",
       y = "GR") +
  theme(plot.title = element_text(size=9),
        axis.title.x = element_text(size=9),
        axis.title.y = element_text(size=9)) +
  scale_x_date(breaks = "months", date_labels = "%b")


gr_marco_maio_evolucao_grafico_interativo <- ggplotly(gr_marco_maio_evolucao_grafico, tooltip = "text")


#### Grafico da evolucao da media de casos dos ultimos 3 dias

rollmean_marco_maio <- rollmean_3_nacional %>% 
  filter(data >= "2020-03-03" & data <= "2020-05-11")

rollmean_marco_maio_grafico <- ggplot(rollmean_marco_maio, aes(x = data, y = confirmados_novos)) + 
  geom_point(size = 0.7, aes(text = paste('Data: ', data,
                                          '<br>Novos casos (MĂ©dia):', confirmados_novos))) +
  geom_smooth(color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  labs(title = "Evolução dos Novos Casos (MĂ©dia dos Últimos 3 dias)",
       x = "MĂȘs",
       y = "Novos Casos (MĂ©dia dos Últimos 3 dias)") +
  theme(plot.title = element_text(size=9),
        axis.title.x = element_text(size=9),
        axis.title.y = element_text(size=9)) +
  scale_x_date(breaks = "months", date_labels = "%b")

rollmean_marco_maio_grafico_interativo <- ggplotly(rollmean_marco_maio_grafico, tooltip = "text")

browsable(
  tagList(list(
    tags$div(
      style = 'width:50%;display:block;float:left;',
      rollmean_marco_maio_grafico_interativo
    ),
    tags$div(
      style = 'width:50%;display:block;float:left;',
      gr_marco_maio_evolucao_grafico_interativo
    )
  ))
)

Maio - Hoje


De maio a setembro a taxa de crescimento de novos casos foi sempre prĂłxima de 1, o que significa que o nĂșmero mĂ©dio de novos casos nos Ășltimos 3 dias foi semelhante Ă  mĂ©dia dos Ășltimos 7 dias. A partir de setembro a taxa tem vindo a aumentar para valores acima de 1 o que Ă© concordante com o grĂĄfico Ă  esquerda, onde Ă© possĂ­vel verificar um grande aumento da mĂ©dia de novos casos dos Ășltimos 3 dias.

#### Grafico da evolucao da taxa de crescimento de novos casos a nivel nacional
gr_maio_hoje <- gr %>% 
  filter(data > "2020-05-11")

gr_maio_hoje_evolucao_grafico <- ggplot(gr_maio_hoje, aes(x = data, y = Growth_Rate)) +
  geom_point(size = 0.7, aes(text = paste('Data: ', data,
                                          '<br>Taxa de Crescimento de Novos Casos:', Growth_Rate))) +
  geom_smooth(color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  ylim(0.7, 1.5) +
  labs(title = "Evolução da Taxa de Crescimento de Novos Casos (GR)",
       x = "MĂȘs",
       y = "GR") +
  theme(plot.title = element_text(size=9),
        axis.title.x = element_text(size=9),
        axis.title.y = element_text(size=9)) +
  scale_x_date(breaks = "months", date_labels = "%b")


gr_maio_hoje_evolucao_grafico_interativo <- ggplotly(gr_maio_hoje_evolucao_grafico, tooltip = "text")


#### Grafico da evolucao da media de casos dos ultimos 3 dias

rollmean_maio_hoje<- rollmean_3_nacional %>% 
  filter(data > "2020-05-11")

rollmean_maio_hoje_grafico <- ggplot(rollmean_maio_hoje, aes(x = data, y = confirmados_novos)) + 
  geom_point(size = 0.7, aes(text = paste('Data: ', data,
                                          '<br>Novos casos (MĂ©dia):', confirmados_novos))) +
  geom_smooth(color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  labs(title = "Evolução dos Novos Casos (MĂ©dia dos Últimos 3 dias)",
       x = "MĂȘs",
       y = "Novos Casos (MĂ©dia dos Últimos 3 dias)") +
  theme(plot.title = element_text(size=9),
        axis.title.x = element_text(size=9),
        axis.title.y = element_text(size=9)) +
  scale_x_date(breaks = "months", date_labels = "%b")

rollmean_maio_hoje_grafico_interativo <- ggplotly(rollmean_maio_hoje_grafico, tooltip = "text")

browsable(
  tagList(list(
    tags$div(
      style = 'width:50%;display:block;float:left;',
      rollmean_maio_hoje_grafico_interativo
    ),
    tags$div(
      style = 'width:50%;display:block;float:left;',
      gr_maio_hoje_evolucao_grafico_interativo
    )
  ))
)

Distrital



Determinação do Desfasamento Ótimo

A mobilidade nĂŁo tem efeitos imediatos no nĂșmero de novos casos. Assim, temos de perceber quanto tempo demora atĂ© Ă  ocorrĂȘncia de uma alteração nesse nĂșmero. Para isso considerĂĄmos que, quando a correlação entre a taxa de mobilidade e a taxa de crescimento de novos casos Ă© mĂĄxima, corresponde ao desfasamento Ăłtimo.


Nacional

Relação

Março - Hoje


Tendo a taxa de mobilidade nacional e a taxa de crescimento de novos casos a nĂ­vel nacional, realizĂĄmos um grĂĄfico para cada desfasamento entre 0 e 30 dias, de modo a perceber como Ă© que estas variĂĄveis se relacionam. Pela anĂĄlise dos grĂĄficos Ă© possĂ­vel verificar que a reta que traça a tendĂȘncia dos pontos tem declive prĂłximo de zero. Isto significa que, apesar do aumento da taxa de mobilidade, a taxa de crescimento de novos casos praticamente nĂŁo se altera.

# Fazer uma tabela com data, growth rate nacional e mobilidade nacional

gr_mr_lag <- left_join(gr, mobilidade_nacional, by = "data")


# Criar variavel com valores do 0 ao 30

lags <- seq(30)


# Atribuir nome a cada futura coluna comecando com mr_ tendo depois o numero respetivo

lag_names <- paste("mr", formatC(lags, width = nchar(max(lags))), 
                   sep = "_")

# Funcao para fazer com que cada coluna seja a coluna anterior descendo uma linha

lag_functions <- setNames(paste("lag(., ", lags, ")"), lag_names)


# Adicionar as colunas anteriores a tabela correlacao

gr_mr_lag <- gr_mr_lag %>% 
  mutate_at(vars(mobilidade_ponderada), funs_(lag_functions))


# Relacao das variaveis

relacao_grmr <- melt(gr_mr_lag[,-1], id.vars = "Growth_Rate")

levels(relacao_grmr$variable) <- 0:30

ggplot(relacao_grmr, aes(value, Growth_Rate, fill = variable)) +
  geom_point() +
  facet_wrap(relacao_grmr$variable) +
  stat_poly_eq(aes(label = paste(..eq.label..)),
               formula = y~x, parse = TRUE, label.y = 0.2) + 
  geom_smooth(method = "lm", se = FALSE, color = "#64CEAA") +
  theme(legend.title = element_blank(),
        legend.position = "none",
        plot.title = element_text(size = 14),
        axis.title.x = element_text(size = 12),
        axis.title.y = element_text(size = 12)) +
  labs(title = "Relação da Taxa de Crescimento de Novos Casos (GR) com a Taxa de Mobilidade (MR) para Diferentes Desfasamentos",
       x = "MR",
       y = "GR")

Março - Maio


#### Grafico Marco - Maio
gr_mr_lag_marco_maio <- gr_mr_lag %>% 
  filter(data >= "2020-03-03" & data <= "2020-05-11")

relacao_marco_maio <- melt(gr_mr_lag_marco_maio[,-1], id.vars = "Growth_Rate")

levels(relacao_marco_maio$variable) <- 0:30

ggplot(relacao_marco_maio, aes(value, Growth_Rate, fill = variable)) +
  geom_point() +
  facet_wrap(relacao_marco_maio$variable) +
  stat_poly_eq(aes(label = paste(..eq.label..)),
               formula = y~x, parse = TRUE, label.y = 1) + 
  geom_smooth(method = "lm", se = FALSE, color = "#64CEAA") +
  theme(legend.title = element_blank(),
        legend.position = "none",
        plot.title = element_text(size = 14),
        axis.title.x = element_text(size = 12),
        axis.title.y = element_text(size = 12)) +
  ylim(0.5, 2) + #alguns valores dos primeiros graficos foram removidos
  labs(title = "Relação da Taxa de Crescimento de Novos Casos (GR) com a Taxa de Mobilidade (MR) entre Março e Maio para Diferentes \nDesfasamentos",
       x = "MR",
       y = "GR")

Maio - Hoje


#### Grafico Maio - Hoje
gr_mr_lag_maio_hoje <- left_join(gr, mobilidade_nacional, by = "data") %>% 
  filter(data > "2020-05-11") %>% 
  mutate_at(vars(mobilidade_ponderada), funs_(lag_functions))

relacao_maio_hoje <- melt(gr_mr_lag_maio_hoje[,-1], id.vars = "Growth_Rate")

levels(relacao_maio_hoje$variable) <- 0:30

ggplot(relacao_maio_hoje, aes(value, Growth_Rate, fill = variable)) +
  geom_point() +
  facet_wrap(relacao_maio_hoje$variable) +
  stat_poly_eq(aes(label = paste(..eq.label..)),
               formula = y~x, parse = TRUE, label.y = 0) + 
  geom_smooth(method = "lm", se = FALSE, color = "#64CEAA") +
  theme(legend.title = element_blank(),
        legend.position = "none",
        plot.title = element_text(size = 14),
        axis.title.x = element_text(size = 12),
        axis.title.y = element_text(size = 12)) +
  labs(title = "Relação da Taxa de Crescimento de Novos Casos (GR) com a Taxa de Mobilidade (MR) entre Maio e Hoje para Diferentes \nDesfasamentos",
       x = "MR",
       y = "GR")

Correlação

Março - Hoje


Ao realizar a correlação entre as taxa de mobilidade e a taxa de crescimento de novos casos para os diferentes desfasamentos, verificamos que a correlação é måxima quando o desfasamento é de 17 dias. No entanto, esta correlação é de apenas 0.25 o que indica uma fraca correlação entre as duas variåveis.

No grĂĄfico Ă  direita Ă© possĂ­vel ver que, no desfasamento Ăłtimo, com o aumento da taxa de mobilidade, a taxa de crescimento de novos casos nĂŁo apresenta grande aumento. Isto Ă© confirmado pelo declive prĂłximo de zero que a reta de regressĂŁo linear apresenta.

Assim podemos concluir que, para o perído de março à atualidade, o aumento da taxa de crescimento de novos casos não é explicado pelo aumento da taxa de mobilidade.

# Ver correlacao

correlacao <- gr_mr_lag[-1] %>% 
  correlate() %>% 
  focus(Growth_Rate)
correlacao[1] = 0:30
names(correlacao) = c("Lag", "correlacao")

correlacao_grafico <- ggplot(correlacao, aes(x = Lag, y = correlacao)) +
  geom_point(aes(text = paste('Lag: ', Lag,
                              '<br>Correlação: ', correlacao))) +
  geom_line() +
  geom_rect(xmin= 16, xmax= 18, ymin=-0.09, ymax=0.3, fill="#64CEAA", size=0.1, alpha = 0.4, 
            aes(fill="Correlação \nsuperior a 0.24")) +
  theme(legend.title = element_blank(),
        plot.title = element_text(size=8),
        legend.text = element_text(size=6),
        axis.title.x = element_text(size = 8),
        axis.title.y = element_text(size = 8)) +
  labs(title = "Correlação entre Taxa de Mobilidade (MR) e Taxa de Crescimento \nde Novos Casos (GR) em Diferentes Desfasamentos (Lag)",
       x = "Lag (dias)",
       y = "Correlação entre MR e GR") +
  scale_x_continuous(breaks = seq(0, 30, 2))

correlacao_grafico_interativo <- ggplotly(correlacao_grafico, tooltip = "text")

# Ver correlacao para lag 17
grmr_grafico <- ggplot(gr_mr_lag, aes(x = mr_17, y = Growth_Rate)) +
  geom_point(size = 0.7, aes(text = paste('Taxa de Mobilidade: ', mr_17,
                          '<br>Taxa de Crescimento de Novos Casos:', Growth_Rate))) +
  geom_smooth(method = "lm", color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  stat_poly_eq(formula = y~x, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +  
  theme(plot.title = element_text(size=8),
        axis.title.x = element_text(size = 8),
        axis.title.y = element_text(size = 8)) +
  ylim(0, 1.5) +
  labs(title = "Relação da Taxa de Crescimento de Novos Casos (GR) com a Taxa \nde Mobilidade (MR) para Lag de 17 dias",
       x = "MR",
       y = "GR") +
  scale_x_continuous(breaks = seq(0, 1, 0.1))

grmr_grafico_interativo <- ggplotly(grmr_grafico, tooltip = "text") %>% 
  layout(annotations = list(x = 0.7, y = 0.4, text = "y = 0.963 + 0.0473 x", showarrow = FALSE))

browsable(
  tagList(list(
    tags$div(
      style = 'width:50%;display:block;float:left;',
      correlacao_grafico_interativo
    ),
    tags$div(
      style = 'width:50%;display:block;float:left;',
      grmr_grafico_interativo
    )
  ))
)
Março - Maio


De seguida decidimos realizar a correlação entre as taxa de mobilidade e a taxa de crescimento de novos casos para os diferentes desfasamentos, para o período de março a maio. Verificåmos que a correlação é måxima quando o desfasamento é de 9 dias, apresentando o valor de cerca de 0.80, indicando uma forte correlação entre as duas variåveis.

No grĂĄfico Ă  direita Ă© possĂ­vel ver que, para o desfasamento Ăłtimo, o aumento da taxa de mobilidade provoca um aumento da taxa de crescimento de novos casos. Por cada aumento de uma unidade da taxa de mobilidade, a taxa de crescimento de novos casos aumenta aproximadamente 0.258 unidades (declive da reta da regressĂŁo linear).

Assim podemos concluir que, para o perĂ­do de março a maio, o aumento da taxa de crescimento de novos casos pode ser explicado pelo aumento da taxa de mobilidade. Apesar de se tratar de um perĂ­odo de quarentena onde a taxa de mobilidade diminuiu consideravelmente em relação ao padrĂŁo, as poucas deslocaçÔes que eram realizadas justificaram o aumento da taxa de crescimento de novos casos pela ausĂȘncia de importantes medidas de mitigação como a obrigatoriedade de uso de mĂĄscaras em locais fechados, a existĂȘncia de desinfetantes para uso da população e a limitação do nĂșmero de pessoas em determinados espaços.

correlacao_marco_maio <- gr_mr_lag_marco_maio[-1] %>% 
  correlate() %>% 
  focus(Growth_Rate)
correlacao_marco_maio[1] = 0:30
names(correlacao_marco_maio) = c("Lag", "correlacao")

correlacao_marco_maio_grafico <- ggplot(correlacao_marco_maio, aes(x = Lag, y = correlacao)) +
  geom_point(aes(text = paste('Lag: ', Lag,
                              '<br>Correlação: ', correlacao))) +
  geom_line() +
  geom_rect(xmin= 9, xmax= 10, ymin=-2, ymax=1, fill="#64CEAA", size=0.1, alpha = 0.4, 
            aes(text="Correlação \nsuperior a 0.75")) +
  theme(legend.title = element_blank(),
        plot.title = element_text(size=7.5),
        legend.text = element_text(size=6),
        axis.title.x = element_text(size = 8),
        axis.title.y = element_text(size = 8)) +
  labs(title = "Correlação entre Taxa de Mobilidade (MR) e Taxa de Crescimento \nde Novos Casos (GR) entre Março e Maio em Diferentes Desfasamentos (Lag)",
       x = "Lag (dias)",
       y = "Correlação entre MR e GR") +
  scale_x_continuous(breaks = seq(0, 30, 2))

correlacao_marco_maio_grafico_interativo <- ggplotly(correlacao_marco_maio_grafico, tooltip = "text")

##### Ver relacao para lag 9
grmr_marco_maio_grafico <- ggplot(gr_mr_lag_marco_maio, aes(x = `mr_ 9`, y = Growth_Rate)) +
  geom_point(size = 0.7, aes(text = paste('Taxa de Mobilidade: ', `mr_ 9`,
                                          '<br>Taxa de Crescimento de Novos Casos:', Growth_Rate))) +
  geom_smooth(method = "lm", color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  stat_poly_eq(formula = y~x, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +  
  theme(plot.title = element_text(size= 7.5),
        axis.title.x = element_text(size = 8),
        axis.title.y = element_text(size = 8)) +
  ylim(0, 1.5) +
  labs(title = "Relação da Taxa de Crescimento de Novos Casos (GR) com a Taxa \nde Mobilidade (MR) entre Março e Maio para Lag de 9 dias",
       x = "MR",
       y = "GR") +
  scale_x_continuous(breaks = seq(0, 1, 0.1))

grmr_marco_maio_grafico_interativo <- ggplotly(grmr_marco_maio_grafico, tooltip = "text") %>% 
  layout(annotations = list(x = 0.7, y = 0.4, text = "y = 0.866 + 0.258 x", showarrow = FALSE))


browsable(
  tagList(list(
    tags$div(
      style = 'width:50%;display:block;float:left;',
      correlacao_marco_maio_grafico_interativo
    ),
    tags$div(
      style = 'width:50%;display:block;float:left;',
      grmr_marco_maio_grafico_interativo
    )
  ))
)
Maio - Hoje


Por fim, ao realizar a correlação entre as taxa de mobilidade e a taxa de crescimento de novos casos para os diferentes desfasamentos, para o período de maio até à atualidade, verificamos que a correlação é måxima quando o desfasamento é de 26 dias. No entanto, esta correlação é de apenas 0.20 o que indica uma fraca correlação entre as duas variåveis.

No grĂĄfico Ă  direita Ă© possĂ­vel ver que, no desfasamento Ăłtimo, com o aumento da taxa de mobilidade, a taxa de crescimento de novos casos nĂŁo apresenta grande aumento. Isto Ă© confirmado pelo declive prĂłximo de zero que a reta de regressĂŁo linear apresenta.

Assim podemos concluir que, para o perído de maio à atualidade, o aumento da taxa de crescimento de novos casos não é explicado pelo aumento da taxa de mobilidade. Isto pode ser devido ao facto de, a partir de maio, terem sido implementadas medidas de mitigação mais rigorosas. Por isso, mesmo quando ocorre um aumento da taxa de mobilidade esta não se reflete num aumento da taxa de crescimento de novos casos.

correlacao_maio_hoje <- gr_mr_lag_maio_hoje[-1] %>% 
  correlate() %>% 
  focus(Growth_Rate)
correlacao_maio_hoje[1] = 0:30
names(correlacao_maio_hoje) = c("Lag", "correlacao")

correlacao_maio_hoje_grafico <- ggplot(correlacao_maio_hoje, aes(x = Lag, y = correlacao)) +
  geom_point(aes(text = paste('Lag: ', Lag,
                              '<br>Correlação: ', correlacao))) +
  geom_line() +
  geom_rect(xmin= 26, xmax= 27, ymin=-0.09, ymax=1, fill="#64CEAA", size=0.1, alpha = 0.4, 
            aes(text="Correlação \nsuperior a 0.20")) +
  theme(legend.title = element_blank(),
        plot.title = element_text(size=8),
        legend.text = element_text(size=6),
        axis.title.x = element_text(size = 8),
        axis.title.y = element_text(size = 8)) +
  labs(title = "Correlação entre Taxa de Mobilidade (MR) e Taxa de Crescimento \nde Novos Casos (GR) de Maio a Hoje em Diferentes Desfasamentos (Lag)",
       x = "Lag (dias)",
       y = "Correlação entre MR e GR") +
  scale_x_continuous(breaks = seq(0, 30, 2))

correlacao_maio_hoje_grafico_interativo <- ggplotly(correlacao_maio_hoje_grafico, tooltip = "text")

##### Ver relacao para lag 26
grmr_maio_hoje_grafico <- ggplot(gr_mr_lag_maio_hoje, aes(x = mr_26, y = Growth_Rate)) +
  geom_point(size = 0.7, aes(text = paste('Taxa de Mobilidade: ', mr_26,
                                          '<br>Taxa de Crescimento de Novos Casos:', Growth_Rate))) +
  geom_smooth(method = "lm", color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  stat_poly_eq(formula = y~x, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +  
  theme(plot.title = element_text(size=8),
        axis.title.x = element_text(size = 8),
        axis.title.y = element_text(size = 8)) +
  ylim(0.7, 1.3) +
  labs(title = "Relação da Taxa de Crescimento de Novos Casos (GR) com a Taxa \nde Mobilidade (MR) entre Maio e Hoje para Lag de 26 dias",
       x = "MR",
       y = "GR") +
  scale_x_continuous(breaks = seq(0, 1, 0.1))

grmr_maio_hoje_grafico_interativo <- ggplotly(grmr_maio_hoje_grafico, tooltip = "text") %>% 
  layout(annotations = list(x = 0.85, y = 0.77, text = "y = 0.93 + 0.078 x", showarrow = FALSE))

browsable(
  tagList(list(
    tags$div(
      style = 'width:50%;display:block;float:left;',
      correlacao_maio_hoje_grafico_interativo
    ),
    tags$div(
      style = 'width:50%;display:block;float:left;',
      grmr_maio_hoje_grafico_interativo
    )
  ))
)

Distrital




ConclusĂŁo

Com esta anĂĄlise podemos concluir que a mobilidade da população influencia o nĂșmero de novos casos apenas quando nĂŁo existem implementadas medidas de mitigação da COVID19. Nestas circunstĂąncias o desfasamento Ăłtimo Ă© de 9 dias, o que significa que o aumento da mobilidade sĂł vai ter repercussĂ”es no aumento do nĂșmero de novos casos passados 9 dias.

Esta conclusĂŁo reforça, assim, a grande importĂąncia destas medidas como a obrigatoriedade do uso de mĂĄscara e a limitação do nĂșmero de pessoas em locais fechados, a lavagem e desinfeção regular das mĂŁos e a recomendação da adoção do distanciamento social.



DĂșvidas


Março - Hoje

#### Com gaussian 

glm <- as.data.frame(coefficients(glm(Growth_Rate ~ mobilidade_ponderada, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr1 = coefficients(glm(Growth_Rate ~ `mr_ 1`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr2 = coefficients(glm(Growth_Rate ~ `mr_ 2`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr3 = coefficients(glm(Growth_Rate ~ `mr_ 3`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr4 = coefficients(glm(Growth_Rate ~ `mr_ 4`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr5 = coefficients(glm(Growth_Rate ~ `mr_ 5`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr6 = coefficients(glm(Growth_Rate ~ `mr_ 6`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr7 = coefficients(glm(Growth_Rate ~ `mr_ 7`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr8 = coefficients(glm(Growth_Rate ~ `mr_ 8`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr9 = coefficients(glm(Growth_Rate ~ `mr_ 9`, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr10 = coefficients(glm(Growth_Rate ~ mr_10, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr11 = coefficients(glm(Growth_Rate ~ mr_11, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr12 = coefficients(glm(Growth_Rate ~ mr_12, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr13 = coefficients(glm(Growth_Rate ~ mr_13, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr14 = coefficients(glm(Growth_Rate ~ mr_14, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr15 = coefficients(glm(Growth_Rate ~ mr_15, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr16 = coefficients(glm(Growth_Rate ~ mr_16, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr17 = coefficients(glm(Growth_Rate ~ mr_17, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr18 = coefficients(glm(Growth_Rate ~ mr_18, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr19 = coefficients(glm(Growth_Rate ~ mr_19, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr20 = coefficients(glm(Growth_Rate ~ mr_20, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr21 = coefficients(glm(Growth_Rate ~ mr_21, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr22 = coefficients(glm(Growth_Rate ~ mr_22, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr23 = coefficients(glm(Growth_Rate ~ mr_23, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr24 = coefficients(glm(Growth_Rate ~ mr_24, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr25 = coefficients(glm(Growth_Rate ~ mr_25, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr26 = coefficients(glm(Growth_Rate ~ mr_26, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr27 = coefficients(glm(Growth_Rate ~ mr_27, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr28 = coefficients(glm(Growth_Rate ~ mr_28, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr29 = coefficients(glm(Growth_Rate ~ mr_29, family = "gaussian", data = gr_mr_lag))) %>% 
  mutate(mr30 = coefficients(glm(Growth_Rate ~ mr_30, family = "gaussian", data = gr_mr_lag))) %>% 
  rbind(0:30)

names(glm)[1] = "mr0"
glm_inv <- as.data.frame(t(glm[c(2, 3),])) %>% 
  rownames_to_column(var = "mr")
names(glm_inv) = c("mr", "coeficiente", "lag")



lag_grafico <- ggplot(glm_inv, aes(x = lag, y = coeficiente)) +
  geom_point() +
  geom_line() +
  geom_rect(xmin= 9, xmax= 11, ymin=-0.09, ymax=0.15, fill="#64CEAA", size=0.1, alpha = 0.4) +
  labs(title = "Correlação entre Mobility Rate e Growth Rate em Diferentes Desfasamentos (lag)",
       x = "Lag (dias)",
       y = "Correlação entre MR e GR") +
  theme(plot.title = element_text(size=9)) +
  scale_x_continuous(breaks = seq(0, 30, 2))
  
lag_grafico_interativo <- ggplotly(lag_grafico)

# Ver relacao para lag 10
grmr_grafico_2 <- ggplot(gr_mr_lag, aes(x = mr_10, y = Growth_Rate)) +
  geom_point(size = 0.7, aes(text = paste('Taxa de Mobilidade: ', mr_10,
                          '<br>Taxa de Crescimento de Novos Casos:', Growth_Rate))) +
  geom_smooth(method = "lm", color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  stat_poly_eq(formula = y~x, 
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")), 
               parse = TRUE) +  
  theme(plot.title = element_text(size=9),
        axis.title.x = element_text(size = 8),
        axis.title.y = element_text(size = 8)) +
  ylim(0, 1.5) +
  labs(title = "Relação da Taxa de Crescimento de Novos Casos (GR) com a Taxa \nde Mobilidade (MR) para Lag de 10 dias",
       x = "MR",
       y = "GR") +
  scale_x_continuous(breaks = seq(0, 1, 0.1))

grmr_grafico_interativo_2 <- ggplotly(grmr_grafico_2, tooltip = "text")

browsable(
  tagList(list(
    tags$div(
      style = 'width:50%;display:block;float:left;',
      lag_grafico_interativo
    ),
    tags$div(
      style = 'width:50%;display:block;float:left;',
      grmr_grafico_interativo_2
    )
  ))
)

Março - Maio

### Calcular a Generalized Linear Regression (glm) entre growth rate nacional e mobility rate nacional para cada lag

#### Com gaussian

glm <- as.data.frame(coefficients(glm(Growth_Rate ~ mobilidade_ponderada, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr1 = coefficients(glm(Growth_Rate ~ `mr_ 1`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr2 = coefficients(glm(Growth_Rate ~ `mr_ 2`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr3 = coefficients(glm(Growth_Rate ~ `mr_ 3`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr4 = coefficients(glm(Growth_Rate ~ `mr_ 4`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr5 = coefficients(glm(Growth_Rate ~ `mr_ 5`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr6 = coefficients(glm(Growth_Rate ~ `mr_ 6`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr7 = coefficients(glm(Growth_Rate ~ `mr_ 7`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr8 = coefficients(glm(Growth_Rate ~ `mr_ 8`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr9 = coefficients(glm(Growth_Rate ~ `mr_ 9`, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr10 = coefficients(glm(Growth_Rate ~ mr_10, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr11 = coefficients(glm(Growth_Rate ~ mr_11, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr12 = coefficients(glm(Growth_Rate ~ mr_12, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr13 = coefficients(glm(Growth_Rate ~ mr_13, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr14 = coefficients(glm(Growth_Rate ~ mr_14, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr15 = coefficients(glm(Growth_Rate ~ mr_15, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr16 = coefficients(glm(Growth_Rate ~ mr_16, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr17 = coefficients(glm(Growth_Rate ~ mr_17, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr18 = coefficients(glm(Growth_Rate ~ mr_18, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr19 = coefficients(glm(Growth_Rate ~ mr_19, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr20 = coefficients(glm(Growth_Rate ~ mr_20, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr21 = coefficients(glm(Growth_Rate ~ mr_21, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr22 = coefficients(glm(Growth_Rate ~ mr_22, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr23 = coefficients(glm(Growth_Rate ~ mr_23, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr24 = coefficients(glm(Growth_Rate ~ mr_24, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr25 = coefficients(glm(Growth_Rate ~ mr_25, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr26 = coefficients(glm(Growth_Rate ~ mr_26, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr27 = coefficients(glm(Growth_Rate ~ mr_27, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr28 = coefficients(glm(Growth_Rate ~ mr_28, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr29 = coefficients(glm(Growth_Rate ~ mr_29, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  mutate(mr30 = coefficients(glm(Growth_Rate ~ mr_30, family = "gaussian", data = gr_mr_lag_marco_maio))) %>%
  rbind(0:30)

names(glm)[1] = "mr0"
glm_inv <- as.data.frame(t(glm[c(2, 3),])) %>%
  rownames_to_column(var = "mr")
names(glm_inv) = c("mr", "coeficiente", "lag")


lag_grafico <- ggplot(glm_inv, aes(x = lag, y = coeficiente)) +
  geom_point() +
  geom_line() +
  #geom_rect(xmin= 26, xmax= 27, ymin=-0.04, ymax=0.15, fill="coral2", size=0.1, alpha = 0.4,
            #aes(text="Correlação \nsuperior a 0.06")) +
  labs(title = "Correlação entre Mobility Rate e Growth Rate entre Março e Maio em Diferentes Desfasamentos (lag)",
       x = "Lag (dias)",
       y = "Correlação entre MR e GR") +
  scale_x_continuous(breaks = seq(0, 30, 2))

ggplotly(lag_grafico)

Maio - Hoje

## Calcular a Generalized Linear Regression (glm) entre growth rate nacional e mobility rate nacional para cada lag

#### Com gaussian

glm <- as.data.frame(coefficients(glm(Growth_Rate ~ mobilidade_ponderada, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr1 = coefficients(glm(Growth_Rate ~ `mr_ 1`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr2 = coefficients(glm(Growth_Rate ~ `mr_ 2`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr3 = coefficients(glm(Growth_Rate ~ `mr_ 3`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr4 = coefficients(glm(Growth_Rate ~ `mr_ 4`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr5 = coefficients(glm(Growth_Rate ~ `mr_ 5`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr6 = coefficients(glm(Growth_Rate ~ `mr_ 6`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr7 = coefficients(glm(Growth_Rate ~ `mr_ 7`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr8 = coefficients(glm(Growth_Rate ~ `mr_ 8`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr9 = coefficients(glm(Growth_Rate ~ `mr_ 9`, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr10 = coefficients(glm(Growth_Rate ~ mr_10, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr11 = coefficients(glm(Growth_Rate ~ mr_11, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr12 = coefficients(glm(Growth_Rate ~ mr_12, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr13 = coefficients(glm(Growth_Rate ~ mr_13, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr14 = coefficients(glm(Growth_Rate ~ mr_14, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr15 = coefficients(glm(Growth_Rate ~ mr_15, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr16 = coefficients(glm(Growth_Rate ~ mr_16, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr17 = coefficients(glm(Growth_Rate ~ mr_17, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr18 = coefficients(glm(Growth_Rate ~ mr_18, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr19 = coefficients(glm(Growth_Rate ~ mr_19, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr20 = coefficients(glm(Growth_Rate ~ mr_20, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr21 = coefficients(glm(Growth_Rate ~ mr_21, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr22 = coefficients(glm(Growth_Rate ~ mr_22, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr23 = coefficients(glm(Growth_Rate ~ mr_23, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr24 = coefficients(glm(Growth_Rate ~ mr_24, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr25 = coefficients(glm(Growth_Rate ~ mr_25, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr26 = coefficients(glm(Growth_Rate ~ mr_26, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr27 = coefficients(glm(Growth_Rate ~ mr_27, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr28 = coefficients(glm(Growth_Rate ~ mr_28, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr29 = coefficients(glm(Growth_Rate ~ mr_29, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  mutate(mr30 = coefficients(glm(Growth_Rate ~ mr_30, family = "gaussian", data = gr_mr_lag_maio_hoje))) %>%
  rbind(0:30)

names(glm)[1] = "mr0"
glm_inv <- as.data.frame(t(glm[c(2, 3),])) %>%
  rownames_to_column(var = "mr")
names(glm_inv) = c("mr", "coeficiente", "lag")



lag_grafico <- ggplot(glm_inv, aes(x = lag, y = coeficiente)) +
  geom_point() +
  geom_line() +
  geom_rect(xmin= 26, xmax= 27, ymin=-0.04, ymax=0.15, fill="#64CEAA", size=0.1, alpha = 0.4,
            aes(text="Correlação \nsuperior a 0.06")) +
  labs(title = "Correlação entre Mobility Rate e Growth Rate entre Maio e Hoje em Diferentes Desfasamentos (lag)",
       x = "Lag (dias)",
       y = "Correlação entre MR e GR") +
  scale_x_continuous(breaks = seq(0, 30, 2))

lag_grafico_interativo <- ggplotly(lag_grafico)

# Ver relacao para lag 26
grmr_grafico_2 <- ggplot(gr_mr_lag, aes(x = mr_26, y = Growth_Rate)) +
  geom_point(size = 0.7, aes(text = paste('Taxa de Mobilidade: ', mr_26,
                                          '<br>Taxa de Crescimento de Novos Casos:', Growth_Rate))) +
  geom_smooth(method = "lm", color = "#64CEAA", se = FALSE, formula = y~x, size = 0.7) +
  stat_poly_eq(formula = y~x,
               aes(label = paste(..eq.label.., ..rr.label.., sep = "~~~")),
               parse = TRUE) +
  theme(plot.title = element_text(size=9),
        axis.title.x = element_text(size = 8),
        axis.title.y = element_text(size = 8)) +
  ylim(0.8, 1.1) +
  labs(title = "Relação da Taxa de Crescimento de Novos Casos (GR) com a Taxa \nde Mobilidade (MR) entre Maio e Hoje para Lag de 26 dias",
       x = "MR",
       y = "GR") +
  scale_x_continuous(breaks = seq(0, 1, 0.1))

grmr_grafico_2_interativo <- ggplotly(grmr_grafico_2, tooltip = "text")

browsable(
  tagList(list(
    tags$div(
      style = 'width:50%;display:block;float:left;',
      lag_grafico_interativo
    ),
    tags$div(
      style = 'width:50%;display:block;float:left;',
      grmr_grafico_2_interativo
    )
  ))
)
 

RelatĂłrio de Carolina Merca & Raquel Costa

karolmerka@hotmail.com & raqueldelobocosta@gmail.com

Â